home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
dskut
/
execut10.zip
/
EXECUTOR.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-03-24
|
4KB
|
133 lines
program Executor;
{$M 16384 0 8192}
uses dos;
const maxlong = 500;
var f : text;
fich : file;
s : string;
i, num : integer;
tab : array[1..maxlong] of string[12];
ext, arch, archiver, command, temp : string;
rec : searchrec;
fi : word;
del : boolean;
begin
writeln('Executor 1.0 - (C) March 1993 V. D''Haeyere');
writeln('');
if not(paramcount in [1..3])
then begin
writeln('Archives each file terminated by a common extension in a archive file');
writeln('derived from the original name.');
writeln;
writeln('If the /D option is used, the original files are also deleted.');
writeln('');
writeln('Command : EXECUTOR <ext> [<archiver>] [/D]');
writeln(' Archive all the files with extension <ext> with');
writeln(' the archiver <archiver>.');
writeln(' Optionally deletes the original files (with /D)');
writeln;
writeln('By default, the archiver is set to LHA and files are NOT deleted.');
writeln('Other supported archivers are PKZIP, ZOO, ARJ, ARC, PKARC. The archiver');
writeln('should be located somewhere on your path or in the current directory.');
writeln;
writeln('>>> Very few error checking is made, and its not garanteed to be bug free...');
writeln;
writeln('This program is freeware (who would pay for it anyway ???) !');
halt(0)
end;
ext:=paramstr(1);
if length(ext)>3
then begin
writeln('Error : an extension is made of up to 3 characters');
halt(1)
end;
archiver:='LHA';
command:='a';
del:=false;
if paramcount>1 then
begin
temp:=paramstr(2);
if (temp='/D') or (temp='/d')
then del:=true
else archiver:=temp
end;
if (paramcount=3)
and ((paramstr(3)='/d') or (paramstr(3)='/D'))
then del:=true;
for i:=1 to length(archiver)
do archiver[i]:=upcase(archiver[i]);
if archiver='LHA'
then command:='a'
else if archiver='PKZIP'
then command:='-a'
else if archiver='PKARC'
then command:='a'
else if archiver='ZOO'
then command:='a'
else if archiver='ARJ'
then command:='a'
else if archiver='ARC'
then command:='a'
else begin
writeln('Archiver unsupported...');
writeln('Supported archivers are LHA, PKZIP, ZOO, ARC, ARJ, PKARC.');
halt(0)
end;
i:=1;
fi:=(anyfile and not(Hidden) and not(VolumeID) and not(Directory) and not(SysFile));
findfirst('*.'+ext, fi, rec);
while (doserror=0) and (i<=maxlong) do
begin
tab[i]:=rec.name;
inc(i);
findnext(rec)
end;
if i>maxlong then
begin
writeln('');
writeln('Only the 500 first files terminated by the extension '+ext);
writeln('will be processed...')
end;
num:=pred(i);
if num>0
then writeln(num,' file(s) are going to be processed...')
else writeln('Nothing to do !');
arch := FSearch(archiver+'.EXE','.;'+GetEnv('PATH'));
if arch='' then
begin
writeln('Error : the archiver could not be located on your path , nor in');
writeln('the current directory.');
halt(1)
end;
for i:=1 to num do
begin
s:=copy(tab[i],1, pred(pos('.',tab[i])));
writeln('File '+s+'.'+ext+' being processed...');
writeln;
exec(arch, command+' '+s+' '+s+'.'+ext);
if del then
begin
assign(fich, s+'.'+ext);
erase(fich);
writeln('File '+s+'.'+ext+' is deleted...');
writeln;
end
end;
if num>0 then writeln('Job done...')
end.